home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / M-More Monthly Disks / (c)m7.d64 / demo.c (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  7KB  |  280 lines

  1. 1000 REM"Q=DSAVE"@DEMO 64",D0
  2. 1010 :
  3. 1020 [143] **  UTILITY DEMO  **
  4. 1030 :
  5. 1040 :
  6. 1050 IN[178]49152: DL[178]IN[170]3 : BG[178]IN[170]6
  7. 1060 DI[178]IN[170]9 : EN[178]IN[170]12: SM[178]IN[170]15
  8. 1080 NS[178]IN[170]18: PZ[178]IN[170]21: SR[178]IN[170]24
  9. 1100 :
  10. 1110 [143]  IN - INPUT ROUTINE
  11. 1120 [143]  DL - INSERT/DELETE IN ARRAYS
  12. 1130 [143]  BG - BLOCKGET (BILL MACLEAN)
  13. 1140 [143]       (TRANSACTOR VOL 2, #7)
  14. 1150 [143]  DI - DISABLE STOP KEY
  15. 1160 [143]  EN - ENABLE STOP KEY
  16. 1180 [143]  SM - STRING MODIFY
  17. 1190 [143]  NS - INSERT STRING FUNCTION
  18. 1200 [143]       (TRANSACTOR VOL 3, #1)
  19. 1210 [143]  PZ - POSITION WITHIN STRING
  20. 1220 [143]       (TRANSACTOR VOL 3, #1)
  21. 1222 [143]  SR - SORT STRING ARRAY
  22. 1224 [143]
  23. 1230 :
  24. 1240 [143] INPUT ROUTINE.
  25. 1250 [143] --------------
  26. 1260 [143]
  27. 1270 [143] SYS IN,ED,MX,L$
  28. 1280 [143]
  29. 1290 [143]  ED - EDIT CHARACTERISTICS
  30. 1300 [143]  MX - STRING LENGTH(1 TO 255)
  31. 1310 [143]  L$ - ANY STRING VARIABLE
  32. 1320 [143]
  33. 1330 [143]    ED - RESULTS
  34. 1340 [143]     0 - ALL CHARACTERS ALLOWED
  35. 1350 [143]     1 - NUMERIC ONLY
  36. 1360 [143]     2 - . + -
  37. 1370 [143]     4 - A TO Z (UPPER/LOWER)
  38. 1380 [143]     8 - A TO Z (FORCE UPPER)
  39. 1390 [143]    16 - BLANK ALLOWED
  40. 1400 [143]    32 - Y,N    (FORCE UPPER)
  41. 1410 [143]    64 - NULL FIELD NOT ALLOWED
  42. 1420 [143]   256 - '0' ON NULL INPUT
  43. 1430 [143]   512 - 'Y' ON NULL INPUT
  44. 1440 [143]  1024 - 'N' ON NULL INPUT
  45. 1450 [143]  2048 - ' ' ON NULL INPUT
  46. 1460 :
  47. 1470 [143] INPUT ROUTINE.
  48. 1480 [143] --------------
  49. 1490 [143]
  50. 1500 [143] THE STRING VARIABLE MUST HAVE
  51. 1510 [143] BEEN DEFINED BEFORE THE SYS.
  52. 1520 [143]
  53. 1530 [143] THE ED VALUES CAN BE OR'D
  54. 1540 [143] TOGETHER.
  55. 1550 [143] IE. ED=3 IS THE SAME AS
  56. 1560 [143]     ED=1+2 (NUMERIC AND +.-)
  57. 1570 [143]
  58. 1580 [143] C.R. ENDS INPUT
  59. 1590 [143] DELETE KEY AS USUAL
  60. 1600 [143] SHIFT-C.R. DELETES ENTIRE
  61. 1610 [143]            LINE OF INPUT
  62. 1620 [143] " CANNOT BE INPUT
  63. 1630 REM
  64. 1640 REM IT IS BEST TO RE-ASSIGN THE
  65. 1650 REM STRING TO UPPER MEMORY BY
  66. 1660 REM      L$=L$+""
  67. 1670 REM SYS IN,0,25,D1$(2)
  68. 1680 REM SYS IN,ED,2,KY$
  69. 1690 :
  70. 1700 REM INSERT/DELETE ROUTINE.
  71. 1710 REM ----------------------
  72. 1720 REM
  73. 1730 REM USED TO INSERT AN ELEMENT OR
  74. 1740 REM DELETE AN ELEMENT FROM ONE
  75. 1750 REM OR MORE ARRAYS.
  76. 1760 REM
  77. 1770 REM SYS DL,SW,PO,EL,A(0),B$(0),ZZ
  78. 1780 REM
  79. 1790 REM  SW - 0=OPEN UP ROOM FOR ONE
  80. 1800 REM         ELEMENT.
  81. 1810 REM       1=DELETE AN ELEMENT.
  82. 1820 REM  PO - POSITION OF ELEMENT.
  83. 1830 REM  EL - # OF ELEMENTS (DELETE)
  84. 1840 REM       # OF ELEMENTS PLUS 1
  85. 1850 REM                     (INSERT)
  86. 1860 REM       THAT ARE IN THE ARRAY
  87. 1870 REM  A(0),B$(0),C%(0),...........
  88. 1880 REM       LIST OF SINGLE DIMEN.
  89. 1890 REM       ARRAYS (ZERO ELEMENT)
  90. 1900 REM  ZZ - TERMINATOR. (MUST BE
  91. 1910 REM       LAST VARIABLE OF SYS)
  92. 1920 :
  93. 1930 REM BLOCK GET.
  94. 1940 REM ----------
  95. 1950 REM
  96. 1960 REM SYS BG,FN,L$
  97. 1970 REM
  98. 1980 REM TAKES THE PLACE OF AN INPUT#FN
  99. 1990 REM STATEMENT.
  100. 2000 REM  FN - FILE NUMBER
  101. 2010 REM  L$ - STRING READ INTO
  102. 2020 REM
  103. 2030 REM OPEN 1,8,3,"0:TEST,S,R"
  104. 2040 REM FOR I=1 TO 10
  105. 2050 REM   SYS BG,1,L$
  106. 2060 REM   D1$(I)=L$+""
  107. 2070 REM NEXT I
  108. 2080 REM
  109. 2090 REM THIS WILL READ FROM ZERO TO
  110. 2100 REM 255 BYTES FROM A FILE. (CR)
  111. 2110 REM TERMINATES INPUT. COMMA DOES
  112. 2120 REM NOT AFFECT INPUT OF DATA.
  113. 2130 :
  114. 2140 REM DISABLE STOP KEY.
  115. 2150 REM -----------------
  116. 2160 REM
  117. 2170 REM SYS DI
  118. 2180 REM
  119. 2190 REM DISABLES THE STOP KEY BUT
  120. 2200 REM ALLOWS THE CLOCK TO RUN.
  121. 2210 REM
  122. 2300 REM ENABLE STOP KEY.
  123. 2310 REM ----------------
  124. 2320 REM
  125. 2330 REM SYS EN
  126. 2340 REM
  127. 2350 REM STOP KEY WILL NOW WORK.
  128. 2360 :
  129. 2370 REM STRING MODIFY.
  130. 2380 REM --------------
  131. 2390 REM
  132. 2400 REM SYS SM,P,L$
  133. 2410 REM
  134. 2420 REM   P=1 CONVERT TO ASCII
  135. 2430 REM   P=2 FORCE UPPER CASE
  136. 2440 REM
  137. 2450 REM SYS SM,2,D1$(15) WILL CONVERT
  138. 2460 REM   THE ALPHA IN THE STRING
  139. 2470 REM   TO UPPER CASE.
  140. 2480 REM
  141. 2490 REM SYS SM,1,K$ WILL CONVERT THE
  142. 2500 REM   CHARACTERS IN K$ TO ASCII
  143. 2510 REM   CHARACTERS. THIS WILL ALLOW
  144. 2520 REM   PRINTING TO CENTRONICS
  145. 2530 REM   PRINTERS, TO THE N.E.C.
  146. 2540 REM   SPINWRITER ETC.
  147. 2550 REM
  148. 2560 :
  149. 2570 REM INSERT STRING FUNCTION
  150. 2580 REM ----------------------
  151. 2590 REM
  152. 2600 REM SYS NS,A$,B$,P
  153. 2610 REM
  154. 2620 REM THIS WILL INSERT THE STRING
  155. 2630 REM   A$ INTO B$ AT POSITION P.
  156. 2640 REM
  157. 2650 REM THE PROGRAM MUST MAKE SURE
  158. 2660 REM   THAT THE STRING BEING
  159. 2670 REM   INSERTED DOES NOT OVERFLOW
  160. 2680 REM   THE END OF B$.
  161. 2690 REM
  162. 2700 REM LEN(A$)+P <= LEN(B$) AND P>0
  163. 2710 REM
  164. 2720 :
  165. 2730 REM POSITION WITHIN STRING
  166. 2740 REM ----------------------
  167. 2750 REM
  168. 2760 REM SYS PZ,A$,B$
  169. 2770 REM
  170. 2780 REM THIS WILL SEARCH FOR THE 1ST
  171. 2790 REM   OCCURANCE OF A$ WITHIN B$.
  172. 2800 REM
  173. 2810 REM PEEK(51200) = 0 IF NOT FOUND
  174. 2820 REM PEEK(51200) = POSITION WITHIN
  175. 2830 REM        B$ THAT A$ OCCURS.
  176. 2840 REM
  177. 2850 :
  178. 2860 REM SORT A STRING ARRAY
  179. 2865 REM -------------------
  180. 2870 REM
  181. 2875 REM SYS SR,K$(0)
  182. 2880 REM
  183. 2885 REM WHERE K$ IS A SINGLE DIMENSION
  184. 2890 REM   STRING ARRAY AND THE ZERO'TH
  185. 2895 REM   ELEMENT IS REFERENCED IN THE
  186. 2900 REM   SUBROUTINE CALL.
  187. 2905 REM
  188. 2910 REM ALL ELEMENTS ARE SORTED. 'NULL'
  189. 2915 REM   STRINGS ARE PUT AT THE END
  190. 2920 REM   OF THE STRING ARRAY.
  191. 2925 REM
  192. 2930 REM THE ZERO'TH ELEMENT IS ALWAYS
  193. 2935 REM   INCLUDED IN THE SORT. THIS
  194. 2940 REM   MEANS THAT AFTER SORTING,
  195. 2945 REM   K$(0) WILL CONTAIN THE
  196. 2950 REM   SMALLEST VALUE AND IF THERE
  197. 2955 REM   ARE 'N' VALID ITEMS IN THE
  198. 2960 REM   STRING ARRAY, K$(N-1) WILL
  199. 2965 REM   HOLD THE LARGEST VALUE.
  200. 2970 REM
  201. 2975 REM TO FORCE THE SORT NOT TO USE
  202. 2980 REM   THE ZERO'TH ARRAY POSITION
  203. 2985 REM   SET IT TO THE FOLLOWING:
  204. 2990 REM        K$(0)=CHR$(1)
  205. 2995 REM
  206. 3000 :
  207. 3001 SYS DI
  208. 3002 PRINT CHR$(8);CHR$(14)
  209. 3010 PO$=""
  210. 3030 PRINT"[147]   [201][206][208][213][212] [196][197][205][207] 1": L$=""
  211. 3040 PRINT LEFT$(PO$,9);"[197][196]: ";
  212. 3050 SYS IN,65,4,L$
  213. 3060 ED=VAL(L$)
  214. 3070 IF ED=9999 THEN 4000
  215. 3080 PRINT LEFT$(PO$,11);"[205][216]: ";
  216. 3090 SYS IN,65,3,L$
  217. 3100 MX=VAL(L$)
  218. 3110 IF MX=0 OR MX>148 THEN 3080
  219. 3120 PRINT LEFT$(PO$,14);"[201]NPUT: ";
  220. 3130 SYS IN,ED,MX,L$: PRINT
  221. 3140 PRINT PO$;L$;
  222. 3150 GET A$:IF A$="" THEN 3150
  223. 3160 PRINT PO$;"                   ";
  224. 3170 GOTO 3010
  225. 4000 :
  226. 4010 H1$(1)=LEFT$(PO$,10)+"1[146] [206]AME: "
  227. 4020 H1$(2)=LEFT$(PO$,11)+"2[146] [193]DR1: "
  228. 4030 H1$(3)=LEFT$(PO$,12)+"3[146] [193]DR2: "
  229. 4040 H1$(4)=LEFT$(PO$,13)+"4[146] [193]DR3: "
  230. 4050 H1$(5)=LEFT$(PO$,14)+"5[146] [208]COD: "
  231. 4060 H1$(6)=LEFT$(PO$,15)+"6[146] [200]OME: "
  232. 4070 H1$(7)=LEFT$(PO$,16)+"7[146] [194]USS: "
  233. 4080 H1$(8)=LEFT$(PO$,17)+"8[146] [195]ODE: "
  234. 4090 LE%(1)=32: ED%(1)=0
  235. 4100 LE%(2)=32: ED%(2)=0
  236. 4110 LE%(3)=32: ED%(3)=0
  237. 4120 LE%(4)=32: ED%(4)=0
  238. 4130 LE%(5)=6 : ED%(5)=9
  239. 4140 LE%(6)=19: ED%(6)=0
  240. 4150 LE%(7)=19: ED%(7)=0
  241. 4160 LE%(8)=20: ED%(8)=27
  242. 5000 :
  243. 5010 PRINT"[147]   [201][206][208][213][212] [196][197][205][207] 2": L$=""
  244. 5020 FOR I=1 TO 8
  245. 5030   PRINT H1$(I);
  246. 5040   ED=ED%(I): MX=LE%(I)
  247. 5050   SYS IN,ED,MX,L$
  248. 5060   D1$(I)=L$+""
  249. 5070 NEXT I
  250. 5080 GET A$: IF A$="" THEN 5080
  251. 6000 :
  252. 6010 PRINT"[147]   [201][206][208][213][212] [196][197][205][207] 3": L$=""
  253. 6020 FOR I=1 TO 8
  254. 6030 PRINT H1$(I);D1$(I);
  255. 6040 NEXT I
  256. 6050 PRINT PO$;"[198]IELD #:[146] ";
  257. 6060 SYS IN,1,1,L$: L=VAL(L$)
  258. 6070 IF L=0 THEN 7000
  259. 6080 IF L>8 THEN 6010
  260. 6090 PRINT PO$;"                ";
  261. 6100 PRINT H1$(L);
  262. 6110 ED=ED%(L): MX=LE%(L)
  263. 6120 SYS IN,ED,MX,L$
  264. 6130 D1$(L)=L$+""
  265. 6140 GOTO 6010
  266. 7000 :
  267. 7010 PRINT"[147]   [211][212][210][201][206][199] [205][207][196][201][198][217]"
  268. 7020 PRINT LEFT$(PO$,8);"[213][208][208][197][210][160]CASE";
  269. 7030 PRINT LEFT$(PO$,10);"[211]TRING: ";
  270. 7040 SYS IN,0,10,L$
  271. 7050 SYS SM,2,L$
  272. 7060 PRINT LEFT$(PO$,12);"        ";L$
  273. 7070 PRINT LEFT$(PO$,16);"[193][211][195][201][201]";
  274. 7080 PRINT LEFT$(PO$,18);"[211]TRING: ";
  275. 7090 SYS IN,0,10,L$
  276. 7100 SYS SM,1,L$
  277. 7110 PRINT LEFT$(PO$,20);"        ";L$
  278. 7120 FOR I=1 TO 10000: NEXT I
  279. 7130 SYS EN: PRINT CHR$(9);CHR$(142)
  280.